home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / weak-refs / pool.scm next >
Encoding:
Text File  |  1992-11-08  |  1.8 KB  |  48 lines
  1. ;;; -*-Scheme-*-
  2. ;;; 
  3. ;;; Scheme provides automatic garbage collection.  However, sometimes
  4. ;;; you know early that an object of a particular type will not be
  5. ;;; used again, so you would like to make it available for re-use.
  6. ;;; 
  7. ;;; This file provides three functions:
  8. ;;;    (make-pool allocator) => pool
  9. ;;;    (allocate pool) => object
  10. ;;;    (release pool object) => unspecified
  11. ;;; The idea is that a pool consists of a list of available objects and
  12. ;;; a function (the allocator) for allocating and initialising new ones.
  13. ;;; When you try to allocate an object from the pool, if there are any
  14. ;;; available objects it will return one of them.  If there aren't any,
  15. ;;; it will call the allocator to make a new one.
  16. ;;; When you have finished with an object, you can add it to the pool
  17. ;;; by calling release.
  18. ;;; When a garbage collection occurs, every pool is forcibly emptied.
  19. ;;; If there are other references to an object in a pool, it will
  20. ;;; survive, so this is quite safe.
  21. ;;; Using this package can save a fair bit of garbage collection.
  22. ;;; You will never get your hands on invalid pointers.  On the other
  23. ;;; hand, you had better be *sure* that you have finished with an
  24. ;;; object before putting it back in a pool.
  25.  
  26. ;;; The representation of a pool is a pair
  27. ;;;    (<allocation function> . <weak reference to list of objects>)
  28.  
  29. (define (make-pool allocator)
  30.     (cons allocator (cons-weak-ref '() '()) ))
  31.  
  32. (define (pool? object)
  33.     (and (pair? object)
  34.      (procedure? (car object))
  35.      (weak-ref? (cdr object))
  36.      (null? (weak-default (cdr object)) )) )
  37.  
  38. (define (allocate pool)
  39.     (let ((available (weak-contents (cdr pool))))
  40.     (if (null? available) ((car pool))
  41.         (begin (weak-set-contents! (cdr pool) (cdr available))
  42.            (car available)) )))
  43.  
  44. (define (release pool object)
  45.     (weak-set-contents! (cdr pool)
  46.     (cons object (weak-contents (cdr pool)) )))
  47.  
  48.